ETO Development Tools 1/ETO Development Tools 1.iso/Tools - Objects/MacApp/MacApp 2.0 CD Release/MacApp 2.0 (Many Libraries)/Libraries/UDialog.inc1.p

Text File | 1990-03-27 | 92.4 KB | 3,683 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ UDDialog.inc1.p }
{ Copyright © 1988-1990 Apple Computer Inc. All rights reserved. }

{--------------------------------------------------------------------------------------------------}
{$S DlgInit}

PROCEDURE InitUDialog;

    BEGIN
    IF qTemplateViews THEN
        BEGIN
        { So the linker doesn't dead strip these }
        IF gDeadStripSuppression THEN
            BEGIN
            IF Member(TObject(NIL), TDialogView) THEN;
            IF Member(TObject(NIL), TControl) THEN;
            IF Member(TObject(NIL), TButton) THEN;
            IF Member(TObject(NIL), TCheckBox) THEN;
            IF Member(TObject(NIL), TRadio) THEN;
            IF Member(TObject(NIL), TCluster) THEN;
            IF Member(TObject(NIL), TIcon) THEN;
            IF Member(TObject(NIL), TPicture) THEN;
            IF Member(TObject(NIL), TPopup) THEN;
            IF Member(TObject(NIL), TStaticText) THEN;
            IF Member(TObject(NIL), TEditText) THEN;
            IF Member(TObject(NIL), TNumberText) THEN;
            IF Member(TObject(NIL), TPattern) THEN;
            END;

        RegisterStdType('TDialogView', kStdDialogView);
        RegisterStdType('TControl', kStdControl);
        RegisterStdType('TButton', kStdButton);
        RegisterStdType('TCheckBox', kStdCheckBox);
        RegisterStdType('TRadio', kStdRadio);
        RegisterStdType('TCluster', kStdCluster);
        RegisterStdType('TIcon', kStdIcon);
        RegisterStdType('TPicture', kStdPicture);
        RegisterStdType('TPopup', kStdPopup);
        RegisterStdType('TStaticText', kStdStaticText);
        RegisterStdType('TEditText', kStdEditText);
        RegisterStdType('TNumberText', kStdNumberText);
        RegisterStdType('TPattern', kStdPattern);
        END;

    gUDialogInitialized := TRUE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE GetMenuColors(popupRect: Rect;
                        menuID, itemNum: INTEGER;
                        VAR fColor, bColor: RGBColor);

    VAR
        gotTitle:            BOOLEAN;
        gdh:                GDHandle;
        mce:                MCEntryPtr;
        titleMce:            MCEntry;
        globalMce:            MCEntry;

    PROCEDURE SetBadColors;

        BEGIN
        fColor := gRGBBlack;
        bColor := gRGBWhite;
        END;

    BEGIN
    gotTitle := False;                                    { Assume the worst. We always do. }

    IF EmptyRect(popupRect) THEN
        SetBadColors                                    { Can't see it anyway so use B&W }
    ELSE IF qNeedsColorQD | gConfiguration.hasColorQD THEN { First, be sure we have color QD… }
        BEGIN
        LocalToGlobal(popupRect.topLeft);                { Globalize rect, in focused coordinates }
        LocalToGlobal(popupRect.botRight);
        gdh := GetMaxDevice(popupRect);                 { Get device characteristics for that rect }

        IF (gdh <> NIL) & (gdh^^.gdPMap^^.pixelSize > 1) THEN { If we have more than two colors }
            BEGIN
            mce := GetMCEntry(menuID, 0);                { Always get title entry }
            IF mce <> NIL THEN
                BEGIN
                gotTitle := TRUE;
                titleMce := mce^;                        { Future calls could shift memory }
                END;

            IF NOT gotTitle THEN                        { If we can't get the title entry, then… }
                BEGIN
                mce := GetMCEntry(0, 0);                { …we'll need the global entry, too }
                IF mce <> NIL THEN
                    globalMce := mce^
                ELSE
                    BEGIN
                    SetBadColors;                        { If no title, AND no global entry, punt }
                    EXIT(GetMenuColors);                { Even if item guy exists. No title, No
                                                         washee }
                    END;
                END;

            { Handle a title color request }
            IF itemNum = 0 THEN
                BEGIN
                IF gotTitle THEN
                    BEGIN
                    fColor := titleMce.mctRGB1;
                    bColor := titleMce.mctRGB2;
                    END
                ELSE                                    { IF gotGlobal << has to be, by this point }
                    BEGIN
                    fColor := globalMce.mctRGB1;
                    bColor := globalMce.mctRGB4;
                    END;
                END
                { Otherwise, it's for an item }
            ELSE
                BEGIN
                mce := GetMCEntry(menuID, itemNum);
                IF mce <> NIL THEN
                    fColor := mce^.mctRGB2
                ELSE IF gotTitle THEN
                    fColor := titleMce.mctRGB3
                ELSE
                    fColor := globalMce.mctRGB3;

                IF gotTitle THEN
                    bColor := titleMce.mctRGB4
                ELSE
                    bColor := globalMce.mctRGB2;
                END;
            END
        ELSE
            SetBadColors;                                { Only one bit depth. Default to B&W }
        END
    ELSE
        SetBadColors;                                    { Not using Color QuickDraw. B&W for sure }

    {$IFC qDebug}
    IF gIntenseDebugging THEN
        BEGIN
        IF itemNum = 0 THEN
            WRITE('Title ')
        ELSE
            WRITE('Item #', itemNum: 0);
        WRITELN(' foreground color- R:', fColor.red: 0, ', G:', fColor.green: 0, ', B:',
                fColor.blue: 0);
        IF itemNum = 0 THEN
            WRITE('Title ')
        ELSE
            WRITE('Item #', itemNum: 0);
        WRITELN(' background color- R:', bColor.red: 0, ', G:', bColor.green: 0, ', B:',
                bColor.blue: 0);
        END;
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TDialogView.IDialogView(itsDocument: TDocument;
                                  itsSuperView: TView;
                                  itsLocation, itsSize: VPoint;
                                  itsHSizeDet, itsVSizeDet: SizeDeterminer;
                                  itsDefItemID, itsCancelItemID: IDType);

    VAR
        anAssociation:        TAssociation;
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    {$IFC qDebug}
    IF NOT gUDialogInitialized THEN
        BEGIN
        ProgramBreak('InitUDialog must be called before creating a Dialog View.');
        Failure(noErr, 0);
        END;
    {$ENDC}

    fParamTxt := NIL;                                    { In case of a catastrophe }
    fTEView := NIL;                                     { Ditto. }
    IView(itsDocument, itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);

    CatchFailures(fi, HandleFailure);
    New(anAssociation);                                 { Okay to allocate list now }
    FailNIL(anAssociation);
    anAssociation.IAssociation;
    fParamTxt := anAssociation;
    fDefaultItem := itsDefItemID;
    fCancelItem := itsCancelItemID;
    fCurrentEditText := NIL;
    fDismissed := False;
    fDismisser := kNoIdentifier;

    fTEView := MakeTEView;
    Success(fi);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TDialogView.IRes(itsDocument: TDocument;
                           itsSuperView: TView;
                           VAR itsParams: Ptr); OVERRIDE;

    VAR
        anAssociation:        TAssociation;
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    {$IFC qDebug}
    IF NOT gUDialogInitialized THEN
        BEGIN
        ProgramBreak('InitUDialog must be called before creating a Dialog View.');
        Failure(noErr, 0);
        END;
    {$ENDC}

    fParamTxt := NIL;                                    { In case of a catastrophe }
    fTEView := NIL;                                     { Ditto. }
    INHERITED IRes(itsDocument, itsSuperView, itsParams);
    WITH DialogViewTemplatePtr(itsParams)^ DO
        BEGIN
        fDefaultItem := defaultItem;
        fCancelItem := cancelItem;
        END;
    CatchFailures(fi, HandleFailure);
    New(anAssociation);                                 { Okay to allocate list now }
    FailNIL(anAssociation);
    anAssociation.IAssociation;
    fParamTxt := anAssociation;
    fCurrentEditText := NIL;
    fDismissed := False;
    fDismisser := kNoIdentifier;

    fTEView := MakeTEView;
    Success(fi);

    OffsetPtr(itsParams, SIZEOF(DialogViewTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TDialogView.WRes(theResource: ViewRsrcHndl;
                           VAR itsParams: Ptr); OVERRIDE;

    VAR
        dgPtr:                DialogViewTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    dgPtr := DialogViewTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(DialogViewTemplate)));

    WITH dgPtr^ DO
        BEGIN
        defaultItem := fDefaultItem;
        cancelItem := fCancelItem;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TDialogView.WriteRes(theResource: ViewRsrcHndl;
                               VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'dlog'; gWResType := 'TDialogView';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TDialogView.Free; OVERRIDE;

    VAR
        itsTEView:            TDialogTEView;

    BEGIN
    FreeIfObject(fParamTxt);
    fParamTxt := NIL;

    { We postpone freeing fTEView because we don't know if it's still associated with an
      edittext view.  (At this point it normally wouldn't be associated with an edittext,
      but you never know…  So, free it after we've free'd all our subviews, including
      any edittext view that fTEView might be associated with. We also disassociated from
      its superview, if any, to avoid having free'd for us by INHERITED Free. }

    itsTEView := fTEView;                                { Can't refer to fTEView after calling
                                                         INHERITED Free }
    fTEView := NIL;

    IF (itsTEView <> NIL) & (itsTEView.fSuperView <> NIL) THEN
        itsTEView.fSuperView.RemoveSubView(itsTEView);

    INHERITED Free;

    FreeIfObject(itsTEView);                            { Now free this puppy }
    itsTEView := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TDialogView.CanDismiss(dismissing: IDType): BOOLEAN;

    VAR
        dismissingView:     TView;
        successful:         BOOLEAN;

    BEGIN
    { First, make sure the view initiating the the dismissal, if any, is enabled. }

    IF LONGINT(dismissing) <> LONGINT(kNoIdentifier) THEN
        dismissingView := FindSubView(dismissing)
    ELSE
        dismissingView := NIL;                            { no dismissing view }

    { Thanks Tommi GESSL }
    successful := (dismissingView = NIL) | (dismissingView.IsViewEnabled);
    CanDismiss := successful;

    IF successful THEN                                    { test only we haven´t failed }
        { Now, if we're not cancelling, make sure the current edit text is valid and
        return false if it isn't.}

        IF (LONGINT(fCancelItem) = LONGINT(kNoIdentifier)) | (dismissing <> fCancelItem) THEN
            BEGIN
            DoSelectEditText(NIL, False);                { Attempt to deselect current edit text }
            CanDismiss := fCurrentEditText = NIL;        { Successful only if it was deselected }
            END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TDialogView.CantDeselect(theEditText: TEditText;
                                   reason: LONGINT);

    VAR
        aString:            Str255;

    BEGIN
    IF reason <> kValidValue THEN
        BEGIN
        IF reason <> kErrorHandled THEN                 { go ahead and post an alert }
            BEGIN
            IF (reason < 1) | (reason > kNoOfDefaultReasons) THEN
                reason := kInvalidValue;

            GetIndString(aString, kInvalidValueReasons, reason);
            ParamText(aString, '', '', '');
            StdAlert(phInvalidValue);
            END;
        aString := theEditText.fDataHandle^^;            { Restart with previous value }
        theEditText.RestartEdit(aString);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TDialogView.Close; OVERRIDE;

    BEGIN
    IF LONGINT(fDismisser) = LONGINT(kNoIdentifier) THEN
        DismissDialog(kNoIdentifier);

    INHERITED Close;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TDialogView.DeselectCurrentEditText: BOOLEAN;

    VAR
        validateResult:     LONGINT;
        itsWindow:            TWindow;
        lastCommand:        TCommand;

    BEGIN
    DeselectCurrentEditText := TRUE;

    IF fCurrentEditText <> NIL THEN
        BEGIN
        { Commit the last command to prevent undo from applying to the wrong edit text,
          and to ensure that all changes are made before validating. }
        IF (fTEView <> NIL) THEN
            BEGIN
            lastCommand := fTEView.GetLastCommand;
            IF (lastCommand <> NIL) & (lastCommand.fView = fTEView) THEN
                fTEView.CommitLastCommand;
            END;

        validateResult := fCurrentEditText.Validate;
        IF validateResult = kValidValue THEN
            BEGIN
            fCurrentEditText.StopEdit;
            fCurrentEditText := NIL;                    { No edit text is selected }
            itsWindow := GetWindow;                     { Patch up the target change }
            IF itsWindow <> NIL THEN
                itsWindow.SetTarget(SELF)
            ELSE
                gApplication.SetTarget(gApplication);
            END
        ELSE
            BEGIN
            CantDeselect(fCurrentEditText, validateResult);
            DeselectCurrentEditText := False;
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TDialogView.DismissDialog(dismisser: IDType);

    VAR
        dismissingControl:    TControl;

    BEGIN
    IF NOT fDismissed THEN
        IF CanDismiss(dismisser) THEN
            BEGIN
            fDismissed := TRUE;
            fDismisser := dismisser;
            END
        ELSE
            Failure(noErr, 0);                            { Silent failure }
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TDialogView.DoChoice(origView: TView;
                               itsChoice: INTEGER); OVERRIDE;

    BEGIN
    CASE itsChoice OF
        mEditTextHit:
            BEGIN
            {$IFC qDebug}
            IF NOT Member(origView, TEditText) THEN
                ProgramBreak('Got mEditTextHit on non-TEditText view.')
            ELSE
            {$ENDC}
                DoSelectEditText(TEditText(origView), False);
            END;
        OTHERWISE
            IF Member(origView, TControl) & TControl(origView).fDismissesDialog THEN
                DismissDialog(origView.fIdentifier)
            ELSE
                INHERITED DoChoice(origView, itsChoice);
    END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TDialogView.DoCommandKey(ch: CHAR;
                                  VAR info: EventInfo): TCommand; OVERRIDE;

    VAR
        cancelView:         TView;

    BEGIN
    IF IsViewEnabled & (ch = '.') & (LONGINT(fCancelItem) <> LONGINT(kNoIdentifier)) THEN
        BEGIN
        cancelView := FindSubView(fCancelItem);
        IF (cancelView <> NIL) & Member(cancelView, TControl) THEN
            BEGIN
            IF cancelView.IsViewEnabled THEN
                TControl(cancelView).Flash;
            TControl(cancelView).DoChoice(cancelView, TControl(cancelView).fDefChoice);
            END
        ELSE
            DoChoice(cancelView, mCancelKey);
        DoCommandKey := NIL;
        END
    ELSE
        DoCommandKey := INHERITED DoCommandKey(ch, info);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TDialogView.DoKeyCommand(ch: CHAR;
                                  aKeyCode: INTEGER;
                                  VAR info: EventInfo): TCommand; OVERRIDE;

    VAR
        defaultView:        TView;
        cancelView:         TView;

    BEGIN
    { If we get this far, nobody's handled the Tab, Enter, or Return keys, so we will  }
    DoKeyCommand := NIL;
    IF IsViewEnabled THEN
        CASE ch OF
            chEscape:
                IF aKeyCode = kClearVirtualCode THEN    { esc double for two different keys! }
                    DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info)
                ELSE IF LONGINT(fCancelItem) <> LONGINT(kNoIdentifier) THEN
                    BEGIN
                    cancelView := FindSubView(fCancelItem);
                    IF (cancelView <> NIL) & Member(cancelView, TControl) THEN
                        BEGIN
                        IF cancelView.IsViewEnabled THEN
                            TControl(cancelView).Flash;
                        TControl(cancelView).DoChoice(cancelView, TControl(cancelView).fDefChoice);
                        END
                    ELSE
                        DoChoice(cancelView, mCancelKey);
                    END
                ELSE
                    DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
            chTab:
                Tab(info.theShiftKey);
            chEnter, chReturn:
                IF LONGINT(fDefaultItem) <> LONGINT(kNoIdentifier) THEN
                    BEGIN
                    defaultView := FindSubView(fDefaultItem);
                    IF (defaultView <> NIL) & Member(defaultView, TControl) THEN
                        BEGIN
                        IF defaultView.IsViewEnabled THEN
                            TControl(defaultView).Flash;
                        TControl(defaultView).DoChoice(defaultView, TControl(defaultView).fDefChoice);
                        END
                    ELSE
                        DoChoice(defaultView, mDefaultKey);
                    END
                ELSE
                    DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
            OTHERWISE
                DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
        END
    ELSE
        DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TDialogView.DoSelectEditText(theEditText: TEditText;
                                       selectChars: BOOLEAN);

    VAR
        itsWindow:            TWindow;

    BEGIN
    IF theEditText <> fCurrentEditText THEN             { If we're not editing this view… }
        BEGIN
        IF DeselectCurrentEditText THEN
            BEGIN
            fCurrentEditText := theEditText;
            IF theEditText <> NIL THEN
                BEGIN
                IF theEditText.fViewEnabled THEN
                    theEditText.StartEdit(selectChars, fTEView)
                    {$IFC qDebug}
                ELSE
                    ProgramBreak('Attempt to select a disabled edit text view')
                    {$ENDC}
                                 ;
                END
            ELSE
                BEGIN
                itsWindow := GetWindow;                 { Set the window's target to self }
                IF itsWindow <> NIL THEN
                    itsWindow.SetTarget(SELF);
                END;
            END;
        END
    ELSE IF selectChars & (theEditText <> NIL) THEN     { Make sure all the chars are selected. }
        theEditText.SetSelection(0, MAXINT, kRedraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TDialogView.EachEditText(PROCEDURE DoToEditText(theEditText: TEditText));

    PROCEDURE CheckSubView(theSubView: TView);

        BEGIN
        IF Member(theSubView, TEditText) THEN
            DoToEditText(TEditText(theSubView))
        ELSE
            theSubView.EachSubView(CheckSubView);
        END;

    BEGIN
    EachSubView(CheckSubView);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TDialogView.GetDialogView: TView; OVERRIDE;

    BEGIN
    GetDialogView := SELF;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TDialogView.Tab(tabBackward: BOOLEAN);

    VAR
        first:                TEditText;
        last:                TEditText;
        next:                TEditText;
        previous:            TEditText;

    BEGIN
    SurveyEditText(first, last, next, previous);

    IF tabBackward THEN
        next := previous;

    IF next <> NIL THEN
        DoSelectEditText(next, TRUE);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

FUNCTION TDialogView.MakeTEView: TDialogTEView;

    VAR
        aDialogTEView:        TDialogTEView;

    BEGIN
    New(aDialogTEView);
    FailNIL(aDialogTEView);
    aDialogTEView.IDialogTEView(NIL, NIL, gZeroVPt, gZeroVPt, sizeRelSuperView, sizeVariable,
                                gZeroRect, gSystemStyle, teJustSystem, kWithoutStyle, False);

    aDialogTEView.fMinAhead := 1;    { Don't _jump_ the view ahead when autoscrolling for
    scrollselectionintoview }

    MakeTEView := aDialogTEView;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAOpen}

PROCEDURE TDialogView.DoOpen;

    VAR
        itsWindow:            TWindow;

    BEGIN
    itsWindow := GetWindow;
    IF (itsWindow <> NIL) & Member(itsWindow.fTarget, TEditText) THEN
        { If the window's target is an edit text view, and that edit text view is installed
          in this dialog, then select it.  Note that this can be problematic if the edit
          text view is in nested dialog views. }
        WITH itsWindow DO
            IF FindSubView(TEditText(fTarget).fIdentifier) = fTarget THEN
                DoSelectEditText(TEditText(fTarget), TRUE);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAOpen}

PROCEDURE TDialogView.Open; OVERRIDE;

    BEGIN
    fDismissed := False;
    fDismisser := kNoIdentifier;
    DoOpen;
    INHERITED Open;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TDialogView.ParamTxt(keyStr, valueStr: Str255);

    BEGIN
    fParamTxt.InsertEntry(keyStr, valueStr);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TDialogView.PoseModally: IDType;

    LABEL 1;

    VAR
        itsWindow:            TWindow;
        fi:                 FailInfo;

    PROCEDURE HdlPoseModally(error: OSErr;
                             message: LONGINT);

        BEGIN
        IF error = noErr THEN
            GOTO 1                                        { If no error then keep the dialog running }
        ELSE
            BEGIN
            fDismissed := TRUE;                         { Avoid validating selected edit text }
            itsWindow.Close;                            { If an error then close the dialog and exit
                                                         via failure mechanism }
            END;
        END;

    BEGIN
    itsWindow := GetWindow;
    IF itsWindow <> NIL THEN
        BEGIN
        gApplication.CommitLastCommand;                 { Make sure that the undo menu reflects }
        { the view being looked at.  Otherwise }
        { the undo menu will be wrong.        }

        itsWindow.Open;
        itsWindow.Select;                                { Bring it to the front }

        fDismissed := False;
        REPEAT
            CatchFailures(fi, HdlPoseModally);
            gApplication.PollEvent(kAllowApplicationToSleep);
            Success(fi);
        1:
        UNTIL fDismissed;
        PoseModally := fDismisser;

        END
    ELSE
        PoseModally := kNoIdentifier;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TDialogView.ReplaceText(VAR theText: Str255);

    PROCEDURE ReplaceOnce(item: TEntry);

        VAR
            index:                INTEGER;

        BEGIN
        WITH item DO
            REPEAT
                index := Pos(fKey^^, theText);
                IF index > 0 THEN
                    BEGIN
                    Delete(theText, index, Length(fKey^^));
                    IF Length(theText) + Length(fValue^^) < SIZEOF(Str255) THEN
                        Insert(fValue^^, theText, index);
                    END;
            UNTIL index = 0;
        END;

    BEGIN
    fParamTxt.fEntries.Each(ReplaceOnce);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TDialogView.SelectEditText(itsIdentifier: IDType;
                                     selectChars: BOOLEAN);

    VAR
        aSubView:            TView;

    BEGIN
    aSubView := FindSubView(itsIdentifier);
    IF (aSubView <> NIL) & (Member(aSubView, TEditText)) THEN
        DoSelectEditText(TEditText(aSubView), selectChars);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TDialogView.SurveyEditText(VAR first, last, next, previous: TEditText);

    VAR
        foundCurrent:        BOOLEAN;

    PROCEDURE Survey(theEditText: TEditText);

        BEGIN
        IF theEditText.fViewEnabled & theEditText.fShown THEN
            BEGIN
            IF first = NIL THEN
                first := theEditText;
            last := theEditText;
            IF theEditText = fCurrentEditText THEN
                foundCurrent := TRUE
            ELSE IF foundCurrent & (next = NIL) THEN
                next := theEditText;
            IF NOT foundCurrent THEN
                previous := theEditText;
            END;
        END;

    BEGIN
    foundCurrent := False;
    next := NIL;
    previous := NIL;
    first := NIL;
    last := NIL;
    EachEditText(Survey);
    IF next = NIL THEN
        next := first;
    IF previous = NIL THEN
        previous := last;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TDialogView.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                 fieldAddr: Ptr;
                                                 fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TDialogView', NIL, bClass);
    DoToField('fDefaultItem', @fDefaultItem, bIDType);
    DoToField('fCancelItem', @fCancelItem, bIDType);
    DoToField('fParamTxt', @fParamTxt, bObject);
    DoToField('fCurrentEditText', @fCurrentEditText, bObject);
    DoToField('fTEView', @fTEView, bObject);
    DoToField('fDismissed', @fDismissed, bBoolean);
    DoToField('fDismisser', @fDismisser, bIDType);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TButton.IButton(itsSuperView: TView;
                          itsLocation, itsSize: VPoint;
                          itsHSizeDet, itsVSizeDet: SizeDeterminer;
                          itsLabel: Str255);

    BEGIN
    ICtlMgr(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet, itsLabel, 0, 0, 0,
            pushButProc);
    fDefChoice := mButtonHit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TButton.IRes(itsDocument: TDocument;
                       itsSuperView: TView;
                       VAR itsParams: Ptr); OVERRIDE;

    VAR
        itsArea:            Rect;

    BEGIN
    INHERITED IRes(NIL, itsSuperView, itsParams);

    fDefChoice := mButtonHit;
    ControlArea(itsArea);
    WITH ButtonTemplatePtr(itsParams)^ DO
        CreateCMgrControl(itsArea, itsLabel, 0, 0, 0, pushButProc);

    OffsetPtrWStr(itsParams, SIZEOF(ButtonTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TButton.WRes(theResource: ViewRsrcHndl;
                       VAR itsParams: Ptr); OVERRIDE;

    VAR
        theLabel:            Str255;
        btPtr:                ButtonTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    GetText(theLabel);

    btPtr := ButtonTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(ButtonTemplate),
                                             Length(theLabel)));

    { btPtr^.itsLabel := theLabel; }
    CopyStr255(theLabel, PRStr(btPtr^.itsLabel));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TButton.WriteRes(theResource: ViewRsrcHndl;
                           VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'butn'; gWResType := 'TButton';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TButton.Fields(PROCEDURE DoToField(fieldName: Str255;
                                             fieldAddr: Ptr;
                                             fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TButton', NIL, bClass);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TCheckBox.ICheckBox(itsSuperView: TView;
                              itsLocation, itsSize: VPoint;
                              itsHSizeDet, itsVSizeDet: SizeDeterminer;
                              itsLabel: Str255;
                              isTurnedOn: BOOLEAN);

    BEGIN
    ICtlMgr(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet, itsLabel, 0, 0, 1,
            checkBoxProc);
    SetState(isTurnedOn, kDontRedraw);
    fDefChoice := mCheckBoxHit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TCheckBox.IRes(itsDocument: TDocument;
                         itsSuperView: TView;
                         VAR itsParams: Ptr); OVERRIDE;

    VAR
        itsArea:            Rect;

    BEGIN
    INHERITED IRes(NIL, itsSuperView, itsParams);

    fDefChoice := mCheckBoxHit;
    ControlArea(itsArea);
    WITH CheckBoxTemplatePtr(itsParams)^ DO
        CreateCMgrControl(itsArea, itsLabel, ORD(isOn), 0, 1, checkBoxProc);

    OffsetPtrWStr(itsParams, SIZEOF(CheckBoxTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TCheckBox.WRes(theResource: ViewRsrcHndl;
                         VAR itsParams: Ptr); OVERRIDE;

    VAR
        theLabel:            Str255;
        cbPtr:                CheckBoxTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    GetText(theLabel);

    cbPtr := CheckBoxTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(CheckBoxTemplate),
                                               Length(theLabel)));

    cbPtr^.isOn := isOn;
    { cbPtr^.itsLabel := theLabel; }
    CopyStr255(theLabel, PRStr(cbPtr^.itsLabel));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TCheckBox.WriteRes(theResource: ViewRsrcHndl;
                             VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'chkb'; gWResType := 'TCheckBox';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TCheckBox.DoChoice(origView: TView;
                             itsChoice: INTEGER);

    BEGIN
    IF itsChoice = mCheckBoxHit THEN
        Toggle(kRedraw);
    INHERITED DoChoice(origView, itsChoice);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TCheckBox.isOn: BOOLEAN;

    BEGIN
    isOn := GetLongVal <> 0;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TCheckBox.SetState(state, redraw: BOOLEAN);

    BEGIN
    SetLongVal(ORD(state), redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TCheckBox.Toggle(redraw: BOOLEAN);

    BEGIN
    SetLongVal(ORD(NOT isOn), redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TCheckBox.ToggleIf(matchState, redraw: BOOLEAN);

    BEGIN
    IF isOn = matchState THEN
        SetLongVal(ORD(NOT isOn), redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TCheckBox.Fields(PROCEDURE DoToField(fieldName: Str255;
                                               fieldAddr: Ptr;
                                               fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TCheckBox', NIL, bClass);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TRadio.IRadio(itsSuperView: TView;
                        itsLocation, itsSize: VPoint;
                        itsHSizeDet, itsVSizeDet: SizeDeterminer;
                        itsLabel: Str255;
                        isTurnedOn: BOOLEAN);

    BEGIN
    ICtlMgr(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet, itsLabel, 0, 0, 1,
            radioButProc);
    SetState(isTurnedOn, kDontRedraw);
    fDefChoice := mRadioHit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TRadio.IRes(itsDocument: TDocument;
                      itsSuperView: TView;
                      VAR itsParams: Ptr); OVERRIDE;

    VAR
        itsArea:            Rect;

    BEGIN
    INHERITED IRes(NIL, itsSuperView, itsParams);

    fDefChoice := mRadioHit;
    ControlArea(itsArea);
    WITH RadioTemplatePtr(itsParams)^ DO
        CreateCMgrControl(itsArea, itsLabel, ORD(isOn), 0, 1, radioButProc);
    OffsetPtrWStr(itsParams, SIZEOF(RadioTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TRadio.WRes(theResource: ViewRsrcHndl;
                      VAR itsParams: Ptr); OVERRIDE;

    VAR
        theLabel:            Str255;
        rdPtr:                RadioTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    GetText(theLabel);

    rdPtr := RadioTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(RadioTemplate),
                                            Length(theLabel)));

    rdPtr^.isOn := isOn;
    { rdPtr^.itsLabel := theLabel; }
    CopyStr255(theLabel, PRStr(rdPtr^.itsLabel));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TRadio.WriteRes(theResource: ViewRsrcHndl;
                          VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'radb'; gWResType := 'TRadio';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TRadio.DoChoice(origView: TView;
                          itsChoice: INTEGER);

    BEGIN
    IF (itsChoice = mRadioHit) & NOT isOn THEN
        Toggle(kRedraw);
    INHERITED DoChoice(origView, itsChoice);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TRadio.isOn: BOOLEAN;

    BEGIN
    isOn := GetLongVal <> 0;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TRadio.SetState(state, redraw: BOOLEAN);

    BEGIN
    SetLongVal(ORD(state), redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TRadio.Toggle(redraw: BOOLEAN);

    BEGIN
    SetLongVal(ORD(NOT isOn), redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TRadio.ToggleIf(matchState, redraw: BOOLEAN);

    BEGIN
    IF isOn = matchState THEN
        SetLongVal(ORD(NOT isOn), redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TRadio.Fields(PROCEDURE DoToField(fieldName: Str255;
                                            fieldAddr: Ptr;
                                            fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TRadio', NIL, bClass);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TCluster.ICluster(itsSuperView: TView;
                            itsLocation, itsSize: VPoint;
                            itsHSizeDet, itsVSizeDet: SizeDeterminer;
                            itsRsrcID, itsIndex: INTEGER);

    VAR
        aString:            Str255;
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fDataHandle := NIL;
    IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
    fRsrcID := itsRsrcID;
    fIndex := itsIndex;
    IF fRsrcID <> kNoResource THEN
        BEGIN
        CatchFailures(fi, HandleFailure);
        GetIndString(aString, fRsrcID, fIndex);
        FailResError;
        Success(fi);
        SetLabel(aString, kDontRedraw);
        END;
    ViewEnable(False, kDontRedraw);                     { Default is not to enable hit testing }
    fDefChoice := mClusterHit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TCluster.IRes(itsDocument: TDocument;
                        itsSuperView: TView;
                        VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    fDataHandle := NIL;
    INHERITED IRes(NIL, itsSuperView, itsParams);
    fDefChoice := mClusterHit;

    WITH ClusterTemplatePtr(itsParams)^ DO
        SetLabel(itsLabel, kDontRedraw);

    OffsetPtrWStr(itsParams, SIZEOF(ClusterTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TCluster.WRes(theResource: ViewRsrcHndl;
                        VAR itsParams: Ptr); OVERRIDE;

    VAR
        theLabel:            Str255;
        clPtr:                ClusterTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    GetLabel(theLabel);

    clPtr := ClusterTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(ClusterTemplate),
                                              Length(theLabel)));

    { clPtr^.itsLabel := theLabel; }
    CopyStr255(theLabel, PRStr(clPtr^.itsLabel));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TCluster.WriteRes(theResource: ViewRsrcHndl;
                            VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'clus'; gWResType := 'TCluster';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TCluster.Free; OVERRIDE;

    BEGIN
    ReleaseLabel;
    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TCluster.DoChoice(origView: TView;
                            itsChoice: INTEGER); OVERRIDE;

    PROCEDURE ResetRadios(aView: TView);

        BEGIN
        IF Member(aView, TRadio) &                        { If the subview is a TRadio, and… }
           (aView <> origView) THEN                     { …it's not the calling radio… }
            TRadio(aView).SetState(False, kRedraw);     { …set it off and redraw it }
        END;

    BEGIN
    IF (itsChoice = mRadioHit) &                        { If we got this far, a radio's changed
                                                         state }
       (origView.fSuperView = SELF) THEN                { Only worry about it if it's our subview! }
        EachSubView(ResetRadios);                        { Reset everybody except the calling radio }
    INHERITED DoChoice(origView, itsChoice);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TCluster.Draw(area: Rect); OVERRIDE;

    VAR
        fontHt:             INTEGER;
        labelWd:            INTEGER;
        oldTop:             INTEGER;
        fInfo:                FontInfo;
        theFrame:            Rect;
        theText:            Str255;
        aDialogView:        TDialogView;
        aTextStyle:         TextStyle;

    BEGIN
    IF qDebug THEN
        AssumeFocused;

    IF fDataHandle <> NIL THEN
        BEGIN
        {$Push} {$H-}
        WITH fPenSize DO
            PenSize(h, v);
        {$Pop}
        GetFontInfo(fInfo);                             { Determine label's height }
        WITH fInfo DO
            fontHt := ascent + descent + leading;
        ControlArea(theFrame);                            { Get the control's extent }
        oldTop := theFrame.top;
        {$Push} {$H-}
        WITH fPenSize DO
            InsetRect(theFrame, h + 1, v + 1);             { Inset the frame a little }
        {$Pop}
        theFrame.top := oldTop + BSR(fontHt, 1);        { Bump top so it cuts label in half }

        FrameRect(theFrame);                            { Draw the frame }

        CopyStr255(fDataHandle^^, @theText);
        aDialogView := TDialogView(GetDialogView);
        IF aDialogView <> NIL THEN
            aDialogView.ReplaceText(theText);

        { !!! Really need a method to draw the title }
        labelWd := StringWidth(theText) + 8;
        SetRect(theFrame, 16, 0, labelWd + 16, fontHt);
        MATextBox(Ptr(ORD4(@theText) + 1), Length(theText), theFrame, teJustCenter, kNoAutoWrap, NIL,
                kEraseFirst, kNoSpaceForCaret);
        END;
    INHERITED Draw(area);                                { Let parents have a chance to draw too }
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TCluster.GetLabel(VAR theLabel: Str255);

    BEGIN
    IF fDataHandle <> NIL THEN
        theLabel := fDataHandle^^
    ELSE
        theLabel := '';
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TCluster.ReleaseLabel;

    BEGIN
    Handle(fDataHandle) := DisposeIfHandle(fDataHandle);

    fRsrcID := kNoResource;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TCluster.ReportCurrent: IDType;

    VAR
        rView:                TView;

    FUNCTION FindRadio(aView: TView): BOOLEAN;

        BEGIN
        FindRadio := Member(aView, TRadio) & TRadio(aView).isOn;
        END;

    BEGIN
    rView := FirstSubViewThat(FindRadio);
    IF rView <> NIL THEN
        ReportCurrent := rView.fIdentifier
    ELSE
        ReportCurrent := kNoIdentifier;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TCluster.SetLabel(theLabel: Str255;
                            redraw: BOOLEAN);

    BEGIN
    ReleaseLabel;
    IF theLabel <> '' THEN
        BEGIN
        fDataHandle := NewString(theLabel);
        IF MemError <> noErr THEN
            fDataHandle := NIL;
        END;
    IF redraw THEN
        ForceRedraw;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TCluster.Fields(PROCEDURE DoToField(fieldName: Str255;
                                              fieldAddr: Ptr;
                                              fieldType: INTEGER)); OVERRIDE;

    VAR
        aString:            Str255;

    BEGIN
    DoToField('TCluster', NIL, bClass);
    DoToField('fRsrcID', @fRsrcID, bInteger);
    DoToField('fIndex', @fIndex, bInteger);
    DoToField('fDataHandle', @fDataHandle, bHandle);
    IF fDataHandle <> NIL THEN
        BEGIN
        aString := fDataHandle^^;
        DoToField('fDataHandle^^', @aString, bString);
        END;

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TIcon.IIcon(itsSuperView: TView;
                      itsLocation, itsSize: VPoint;
                      itsHSizeDet, itsVSizeDet: SizeDeterminer;
                      itsRsrcID: INTEGER;
                      preferColor: BOOLEAN);

    VAR
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fDataHandle := NIL;
    IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
    fPreferColor := preferColor;
    fRsrcID := itsRsrcID;
    IF fRsrcID <> kNoResource THEN
        BEGIN
        CatchFailures(fi, HandleFailure);
        IF fPreferColor THEN
            IF qNeedsColorQD | gConfiguration.hasColorQD THEN
                fDataHandle := Handle(GetCIcon(fRsrcID));
        IF fDataHandle = NIL THEN
            BEGIN
            fDataHandle := GetIcon(fRsrcID);
            IF fDataHandle <> NIL THEN
                fPreferColor := NOT kPreferColor;        { Either can't or won't }
            END;
        FailResError;
        Success(fi);
        END;
    ViewEnable(False, kDontRedraw);                     { Default is to not enable hit testing }
    fDefChoice := mIconHit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TIcon.IRes(itsDocument: TDocument;
                     itsSuperView: TView;
                     VAR itsParams: Ptr); OVERRIDE;

    VAR
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fDataHandle := NIL;
    INHERITED IRes(NIL, itsSuperView, itsParams);

    WITH IconTemplatePtr(itsParams)^ DO
        BEGIN
        fPreferColor := preferColor;
        fRsrcID := rsrcID;
        END;
    IF fRsrcID <> kNoResource THEN
        BEGIN
        CatchFailures(fi, HandleFailure);
        IF fPreferColor THEN
            IF qNeedsColorQD | gConfiguration.hasColorQD THEN
                fDataHandle := Handle(GetCIcon(fRsrcID));
        IF fDataHandle = NIL THEN
            BEGIN
            fDataHandle := GetIcon(fRsrcID);
            IF fDataHandle <> NIL THEN
                fPreferColor := NOT kPreferColor;        { Either can't or won't }
            END;
        { Don't die because resource not found - just return NIL handle }
        FailResError;
        Success(fi);
        END;
    fDefChoice := mIconHit;

    OffsetPtr(itsParams, SIZEOF(IconTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TIcon.WRes(theResource: ViewRsrcHndl;
                     VAR itsParams: Ptr); OVERRIDE;

    VAR
        icPtr:                IconTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    icPtr := IconTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(IconTemplate)));

    WITH icPtr^ DO
        BEGIN
        preferColor := fPreferColor;
        {$IFC qDebug}
        IF fRsrcID = kNoResource THEN
            WRITELN('Tried to write TIcon with no resource ID.');
        {$ENDC}
        rsrcID := fRsrcID;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TIcon.WriteRes(theResource: ViewRsrcHndl;
                         VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'icon'; gWResType := 'TIcon';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TIcon.Free; OVERRIDE;

    BEGIN
    ReleaseIcon;

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TIcon.Draw(area: Rect); OVERRIDE;

    VAR
        oldState: SignedByte;
        theRect: Rect;
        aPixMap: PixMap;
        aBitMapPtr: BitMapPtr;
        srcRect: Rect;

    BEGIN
    IF fDataHandle <> NIL THEN
        BEGIN
        IF fRsrcID <> kNoResource THEN
            LoadResource(fDataHandle);
        IF fDataHandle^ <> NIL THEN            { If there's room for the icon… }
            BEGIN
            PenNormal;                        { NECESSARY? }
            ControlArea(theRect);
            oldState := GetHandleBits(fDataHandle);
            HNoPurge(fDataHandle);
            HLock(fDataHandle);

            IF fPreferColor THEN
                BEGIN

                { We can't use PlotCIcon here because it can't be written to a picture }
                { and when WriteToDeskScrap is called, the icon is plotted on the }
                { desktop rather than in the picture.  So instead, pick apart the color }
                { icon handle and use copybits, ignoring the mask. }

                aPixMap := CIconHandle(fDataHandle)^^.iconPMap;
                HLock(CIconHandle(fDataHandle)^^.iconData);
                aPixMap.baseAddr := CIconHandle(fDataHandle)^^.iconData^;
                srcRect := aPixMap.bounds;
                aBitMapPtr := @aPixMap;
                CopyBits(aBitMapPtr^, thePort^.portBits, srcRect, theRect, srcCopy, NIL);
                HUnLock(CIconHandle(fDataHandle)^^.iconData);
                END
            ELSE
                PlotIcon(theRect, fDataHandle);

            SetHandleBits(fDataHandle, oldState);
            END;
        END;

    INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TIcon.ReleaseIcon;

    BEGIN
    fRsrcID := kNoResource;
    IF fDataHandle <> NIL THEN
        BEGIN
        IF fPreferColor THEN
            DisposCIcon(CIconHandle(fDataHandle))
        ELSE
            HPurge(fDataHandle);
        fDataHandle := NIL;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TIcon.SetIcon(theIcon: Handle;
                        redraw: BOOLEAN);

    BEGIN
    ReleaseIcon;
    fDataHandle := theIcon;
    IF redraw THEN
        ForceRedraw;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TIcon.Fields(PROCEDURE DoToField(fieldName: Str255;
                                           fieldAddr: Ptr;
                                           fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TIcon', NIL, bClass);
    DoToField('fPreferColor', @fPreferColor, bBoolean);
    DoToField('fRsrcID', @fRsrcID, bInteger);
    DoToField('fDataHandle', @fDataHandle, bHandle);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TPattern.IPattern(itsSuperView: TView;
                            itsLocation, itsSize: VPoint;
                            itsHSizeDet, itsVSizeDet: SizeDeterminer;
                            itsRsrcID: INTEGER;
                            preferColor: BOOLEAN);

    VAR
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fDataHandle := NIL;
    IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
    fPreferColor := preferColor;
    fRsrcID := itsRsrcID;
    IF fRsrcID <> kNoResource THEN
        BEGIN
        CatchFailures(fi, HandleFailure);
        IF fPreferColor THEN
            IF qNeedsColorQD | gConfiguration.hasColorQD THEN
                fDataHandle := Handle(GetPixPat(fRsrcID));
        IF fDataHandle = NIL THEN
            BEGIN
            fDataHandle := Handle(GetPattern(fRsrcID));
            IF fDataHandle <> NIL THEN
                fPreferColor := NOT kPreferColor;        { Either can't or won't }
            END;
        FailResError;
        Success(fi);
        END;
    ViewEnable(False, kDontRedraw);                     { Default is to not enable hit testing }
    fDefChoice := mPatternHit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TPattern.IRes(itsDocument: TDocument;
                        itsSuperView: TView;
                        VAR itsParams: Ptr); OVERRIDE;

    VAR
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fDataHandle := NIL;
    INHERITED IRes(NIL, itsSuperView, itsParams);

    WITH PatternTemplatePtr(itsParams)^ DO
        BEGIN
        fPreferColor := preferColor;
        fRsrcID := rsrcID;
        END;
    IF fRsrcID <> kNoResource THEN
        BEGIN
        CatchFailures(fi, HandleFailure);
        IF fPreferColor THEN
            IF qNeedsColorQD | gConfiguration.hasColorQD THEN
                fDataHandle := Handle(GetPixPat(fRsrcID));
        IF fDataHandle = NIL THEN
            BEGIN
            fDataHandle := Handle(GetPattern(fRsrcID));
            IF fDataHandle <> NIL THEN
                fPreferColor := NOT kPreferColor;        { Either can't or won't }
            END;
        FailResError;
        Success(fi);
        END;
    fDefChoice := mPatternHit;

    OffsetPtr(itsParams, SIZEOF(PatternTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TPattern.WRes(theResource: ViewRsrcHndl;
                        VAR itsParams: Ptr); OVERRIDE;

    VAR
        ptPtr:                PatternTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    ptPtr := PatternTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(PatternTemplate)));

    WITH ptPtr^ DO
        BEGIN
        preferColor := fPreferColor;
        {$IFC qDebug}
        IF fRsrcID = kNoResource THEN
            WRITELN('Tried to write TPattern with no resource ID.');
        {$ENDC}
        rsrcID := fRsrcID;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TPattern.WriteRes(theResource: ViewRsrcHndl;
                            VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'patn'; gWResType := 'TPattern';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TPattern.Free; OVERRIDE;

    BEGIN
    ReleasePattern;

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TPattern.Draw(area: Rect); OVERRIDE;

    VAR
        wasLocked:            BOOLEAN;
        theRect:            Rect;

    BEGIN
    IF fDataHandle <> NIL THEN
        BEGIN
        IF (fRsrcID <> kNoResource) & NOT fPreferColor THEN { Pixpat handles <> resource handles }
            LoadResource(fDataHandle);
        IF fDataHandle^ <> NIL THEN                     { If there's room for the pattern… }
            BEGIN
            PenNormal;                                    { NECESSARY? }
            ControlArea(theRect);
            wasLocked := IsHandleLocked(fDataHandle);    { Remember current lock state }
            IF NOT wasLocked THEN
                HLock(fDataHandle);                     { Because FillRect may move memory }
            IF fPreferColor THEN
                FillCRect(theRect, PixPatHandle(fDataHandle))
            ELSE
                FillRect(theRect, PatHandle(fDataHandle)^^);
            IF NOT wasLocked THEN
                HUnLock(fDataHandle);                    { restore handle's unlocked state }
            END
        END;

    INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TPattern.ReleasePattern;

    BEGIN
    fRsrcID := kNoResource;
    IF fDataHandle <> NIL THEN
        BEGIN
        IF fPreferColor THEN
            DisposPixPat(PixPatHandle(fDataHandle))
        ELSE
            HPurge(fDataHandle);
        fDataHandle := NIL;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TPattern.SetPattern(thePattern: Handle;
                              redraw: BOOLEAN);

    BEGIN
    ReleasePattern;
    fDataHandle := thePattern;
    IF redraw THEN
        ForceRedraw;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TPattern.Fields(PROCEDURE DoToField(fieldName: Str255;
                                              fieldAddr: Ptr;
                                              fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TPattern', NIL, bClass);
    DoToField('fPreferColor', @fPreferColor, bBoolean);
    DoToField('fRsrcID', @fRsrcID, bInteger);
    DoToField('fDataHandle', @fDataHandle, bHandle);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TPicture.IPicture(itsSuperView: TView;
                            itsLocation, itsSize: VPoint;
                            itsHSizeDet, itsVSizeDet: SizeDeterminer;
                            itsRsrcID: INTEGER);

    VAR
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fDataHandle := NIL;
    IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
    fRsrcID := itsRsrcID;
    IF fRsrcID <> kNoResource THEN
        BEGIN
        CatchFailures(fi, HandleFailure);
        fDataHandle := GetPicture(fRsrcID);
        FailResError;
        Success(fi);
        END;
    ViewEnable(False, kDontRedraw);                     { Default is to not enable hit testing }
    fDefChoice := mPictureHit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TPicture.IRes(itsDocument: TDocument;
                        itsSuperView: TView;
                        VAR itsParams: Ptr); OVERRIDE;

    VAR
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fDataHandle := NIL;
    INHERITED IRes(NIL, itsSuperView, itsParams);

    fRsrcID := PictureTemplatePtr(itsParams)^.rsrcID;
    IF fRsrcID <> kNoResource THEN
        BEGIN
        CatchFailures(fi, HandleFailure);
        fDataHandle := GetPicture(fRsrcID);
        FailResError;
        Success(fi);
        END;
    fDefChoice := mPictureHit;

    OffsetPtr(itsParams, SIZEOF(PictureTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TPicture.WRes(theResource: ViewRsrcHndl;
                        VAR itsParams: Ptr); OVERRIDE;

    VAR
        pcPtr:                PictureTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    pcPtr := PictureTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(PictureTemplate)));

    {$IFC qDebug}
    IF fRsrcID = kNoResource THEN
        WRITELN('Tried to write TPicture with no resource ID.');
    {$ENDC}
    pcPtr^.rsrcID := fRsrcID;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TPicture.WriteRes(theResource: ViewRsrcHndl;
                            VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'pict'; gWResType := 'TPicture';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TPicture.Free; OVERRIDE;

    BEGIN
    ReleasePicture;

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TPicture.Draw(area: Rect); OVERRIDE;

    VAR
        oldState:            SignedByte;
        theRect:            Rect;

    BEGIN
    IF fDataHandle <> NIL THEN
        BEGIN
        IF fRsrcID <> kNoResource THEN
            LoadResource(Handle(fDataHandle));
        IF fDataHandle^ <> NIL THEN                     { If there's room for the picture… }
            BEGIN
            ControlArea(theRect);
            oldState := GetHandleBits(Handle(fDataHandle));
            HNoPurge(Handle(fDataHandle));
            PenNormal;                                    { ??? NECESSARY ??? }
            DrawPicture(fDataHandle, theRect);
            SetHandleBits(Handle(fDataHandle), oldState);
            END;
        END;
    INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TPicture.ReleasePicture;

    BEGIN
    fRsrcID := kNoResource;
    IF fDataHandle <> NIL THEN
        BEGIN
        HPurge(Handle(fDataHandle));
        fDataHandle := NIL;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TPicture.SetPicture(thePicture: PicHandle;
                              redraw: BOOLEAN);

    BEGIN
    ReleasePicture;
    fDataHandle := thePicture;
    IF redraw THEN
        ForceRedraw;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TPicture.Fields(PROCEDURE DoToField(fieldName: Str255;
                                              fieldAddr: Ptr;
                                              fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TPicture', NIL, bClass);
    DoToField('fRsrcID', @fRsrcID, bInteger);
    DoToField('fDataHandle', @fDataHandle, bHandle);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TPopup.IPopup(itsSuperView: TView;
                        itsLocation, itsSize: VPoint;
                        itsHSizeDet, itsVSizeDet: SizeDeterminer;
                        itsRsrcID, itsCurrentItem, itsItemOffset: INTEGER);

    VAR
        fi:                 FailInfo;
        aMenu:                MenuHandle;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fMenuHandle := NIL;
    IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);

    IF qNeedsHierarchicalMenus | gConfiguration.hasHierarchicalMenus THEN
        BEGIN
        fCurrentItem := Max(1, itsCurrentItem);
        fItemOffset := itsItemOffset;
        IF itsRsrcID <> kNoResource THEN
            BEGIN
            CatchFailures(fi, HandleFailure);
            aMenu := GetMenu(itsRsrcID);
            { Don't die because resource not found - just return NIL handle }
            FailResError;
            HNoPurge(Handle(aMenu));
            SetPopup(aMenu, itsRsrcID, itsCurrentItem, False);
            Success(fi);
            END
        ELSE
            BEGIN
            fRsrcID := kNoResource;
            fMenuID := kNoResource;
            END;
        fDefChoice := mPopupHit;
        END
    ELSE
        BEGIN
        {$IFC qDebug}
        ProgramBreak('Attempt to use popup menus on machine that doesn''t support them');
        {$ENDC}
        fShown := False;                                { What's reasonable here ??? }
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TPopup.IRes(itsDocument: TDocument;
                      itsSuperView: TView;
                      VAR itsParams: Ptr); OVERRIDE;

    VAR
        fi:                 FailInfo;
        aMenu:                MenuHandle;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fMenuHandle := NIL;
    INHERITED IRes(NIL, itsSuperView, itsParams);

    {$IFC NOT qNeedsHierarchicalMenus}
    IF NOT gConfiguration.hasHierarchicalMenus THEN
        BEGIN
        {$IFC qDebug}
        ProgramBreak('Attempt to use popup menus on machine that doesn''t support them');
        {$ENDC}
        fShown := False;                                { What's reasonable here ??? }
        END
    ELSE
    {$ENDC}
        BEGIN
        WITH PopupTemplatePtr(itsParams)^ DO
            BEGIN
            fCurrentItem := Max(1, currentItem);
            fItemOffset := itemOffset;
            fRsrcID := rsrcID;
            IF rsrcID <> kNoResource THEN
                BEGIN
                CatchFailures(fi, HandleFailure);
                aMenu := GetMenu(rsrcID);
                { Don't die because resource not found - just return NIL handle }
                FailResError;
                IF aMenu <> NIL THEN
                    HNoPurge(Handle(aMenu));
                SetPopup(aMenu, rsrcID, fCurrentItem, False);
                Success(fi);
                END
            ELSE
                fMenuID := kNoResource;
            END;
        fDefChoice := mPopupHit;
        END;

    OffsetPtr(itsParams, SIZEOF(PopupTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TPopup.WRes(theResource: ViewRsrcHndl;
                      VAR itsParams: Ptr); OVERRIDE;

    VAR
        poPtr:                PopupTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    poPtr := PopupTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(PopupTemplate)));

    WITH poPtr^ DO
        BEGIN
        {$IFC qDebug}
        IF fRsrcID = kNoResource THEN
            ProgramBreak('Tried to write TPopup with no resource ID.');
        {$ENDC}
        rsrcID := fRsrcID;
        currentItem := fCurrentItem;
        itemOffset := fItemOffset;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TPopup.WriteRes(theResource: ViewRsrcHndl;
                          VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'popp'; gWResType := 'TPopup';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TPopup.Free; OVERRIDE;

    BEGIN
    ReleasePopup;

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TPopup.AdjustBotRight;

    VAR
        newHeight:            INTEGER;
        newWidth:            INTEGER;
        theFontInfo:        FontInfo;

    BEGIN
    IF fMenuHandle <> NIL THEN
        BEGIN
        CalcMenuSize(fMenuHandle);
        newWidth := fMenuHandle^^.menuWidth + fItemOffset + fInset.left + fInset.right + 3;

        GetTextStyleFontInfo(gSystemStyle, theFontInfo);

        WITH theFontInfo DO
            newHeight := ascent + descent + leading + fInset.top + fInset.bottom + 3;

        Resize(newWidth, newHeight, kDontInvalidate);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TPopup.CalcLabelRect(VAR theRect: Rect);

    VAR
        theLabel:            Str255;

    BEGIN
    ControlArea(theRect);
    InsetRect(theRect, 1, 1);
    WITH theRect DO
        BEGIN
        right := left + fItemOffset - 1;                { adjust right }
        bottom := bottom - 1;                            { adjust bottom }
        theLabel := fMenuHandle^^.menuData;             { fetch the title of the menu }
        left := Max(left, right - StringWidth(theLabel) - 2); { adjust left }
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TPopup.CalcMenuRect(VAR theRect: Rect);

    BEGIN
    ControlArea(theRect);
    InsetRect(theRect, 1, 1);
    WITH theRect DO
        BEGIN
        left := left + fItemOffset;
        {WITH botRight DO
            BEGIN
            h := h - 1;
            v := v - 1;
            END;}
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TPopup.DoMouseCommand(VAR theMouse: Point;
                               VAR info: EventInfo;
                               VAR hysteresis: Point): TCommand; OVERRIDE;

    VAR
        newChoice:            INTEGER;
        result:             LONGINT;
        menuPt:             Point;
        aMenuHandle:        MenuHandle;
        labelRect:            Rect;
        menuRect:            Rect;
        oldFColor:            RGBColor;
        oldBkColor:         RGBColor;
        newFColor:            RGBColor;
        newBkColor:         RGBColor;
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        DeleteMenu(fMenuID);
        SetIfColor(oldFColor); SetIfBkColor(oldBkColor);
        END;

    BEGIN
    DoMouseCommand := NIL;
    CalcLabelRect(labelRect);
    CalcMenuRect(menuRect);                             { ??? test if theMouse is in menuRect ??? }

    IF fMenuHandle <> NIL THEN
        BEGIN
        MAInsertMenu(fMenuHandle, hierMenu);            { MAInsertMenu ensures colors are set }
        { Save the old colors, fetch the item colors, and draw the popup box }
        GetIfColor(oldFColor); GetIfBkColor(oldBkColor);
        GetMenuColors(menuRect, fMenuID, 0, newFColor, newBkColor);
        SetIfColor(newBkColor); SetIfBkColor(newFColor);
        DrawLabel(labelRect);

        IF (fRsrcID <> kNoResource) THEN
            IF qNeedsColorQD | gConfiguration.hasColorQD THEN
                aMenuHandle := GetResMenu(fRsrcID);     { Reloads color tables! }
        WITH menuRect DO
            SetPt(menuPt, left, top);                     { Don't overwrite stuff next to the label }
        LocalToGlobal(menuPt);
        CalcMenuSize(fMenuHandle);                        { Fix for Menu Manager bug }

        SetIfColor(oldFColor); SetIfBkColor(oldBkColor);
        InsetRect(menuRect, - 1, - 1);
        EraseRect(menuRect);

        result := PopUpMenuSelect(fMenuHandle, menuPt.v, menuPt.h, fCurrentItem);
        newChoice := LoWord(result);
        SetIfColor(newFColor); SetIfBkColor(newBkColor);
        DrawLabel(labelRect);
        IF (HiWord(result) <> 0) & (newChoice <> fCurrentItem) THEN
            BEGIN
            SetCurrentItem(newChoice, kRedraw);
            CatchFailures(fi, HandleFailure);
            DoChoice(SELF, fDefChoice);
            Success(fi);
            END
        ELSE
            SetCurrentItem(fCurrentItem, kRedraw);
        DeleteMenu(fMenuID);
        SetIfColor(oldFColor); SetIfBkColor(oldBkColor);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TPopup.Draw(area: Rect); OVERRIDE;

    VAR
        aRect:                Rect;
        oldFColor:            RGBColor;
        oldBkColor:         RGBColor;
        newFColor:            RGBColor;
        newBkColor:         RGBColor;

    BEGIN
    IF fMenuHandle <> NIL THEN
        BEGIN
        MAInsertMenu(fMenuHandle, hierMenu);            { MAInsertMenu ensures colors are set }
        { Erase the whole menu first }
        ControlArea(aRect);
        IF SectRect(area, aRect, aRect) THEN
            BEGIN
            { EraseRect(aRect); }

            { Save the old colors, fetch the item colors, and draw the popup box }
            GetIfColor(oldFColor); GetIfBkColor(oldBkColor);
            CalcMenuRect(aRect);
            GetMenuColors(aRect, fMenuID, fCurrentItem, newFColor, newBkColor);
            SetIfColor(newFColor); SetIfBkColor(newBkColor);
            DrawPopupBox(area);

            { Fetch the title colors, and draw it }
            GetMenuColors(aRect, fMenuID, 0, newFColor, newBkColor);
            SetIfColor(newFColor); SetIfBkColor(newBkColor);
            DrawLabel(area);

            { Reset colors to their original state }
            SetIfColor(oldFColor); SetIfBkColor(oldBkColor);
            END;
        DeleteMenu(fMenuID);
        END;

    INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TPopup.DrawLabel(area: Rect);

    VAR
        labelRect:            Rect;
        theLabel:            Str255;

    BEGIN
    CalcLabelRect(labelRect);
    IF SectRect(area, labelRect, area) THEN
        BEGIN

        {$IFC qDebug}
        AssumeFocused;
        {$ENDC}

        theLabel := fMenuHandle^^.menuData;             { Fetch the title of the menu }
        IF Length(theLabel) > 0 THEN
            BEGIN
            EraseRect(labelRect);                { Might be switching colors }
            MADrawString(@theLabel, labelRect, teJustSystem);
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TPopup.DrawPopupBox(area: Rect);

    CONST
        ShadowedFrame        = [adnLineTop, adnLineLeft, adnLineBottom, adnLineRight, adnShadow];
        leftSlop            = 15;                        { should be 13 to image like it used to
                                                        (off by 2 pixels)  at 15 it images exactly
                                                        the same when popped up or not. }
        rightSlop            = 1;
        botSlop             = 6;

    VAR
        wid:                INTEGER;
        newWid:             INTEGER;
        newLen:             INTEGER;
        menuRect:            Rect;
        colorRect:            Rect;
        theItemRect:        Rect;
        theItem:            Str255;
        theFontInfo:        FontInfo;

    BEGIN
    CalcMenuRect(menuRect);
    GetItem(fMenuHandle, fCurrentItem, theItem);
    WITH menuRect DO
        BEGIN
        IF NOT EmptyRect(menuRect) THEN
            BEGIN
            InsetRect(menuRect, - 1, - 1);
            IF SectRect(area, menuRect, colorRect) THEN
                BEGIN
                wid := (right - left) - (leftSlop + rightSlop);
                newWid := StringWidth(theItem);
                IF newWid > wid THEN
                    BEGIN
                    newLen := Length(theItem);

                    REPEAT
                        theItem[newLen] := '…';
                        theItem[0] := CHR(newLen);
                        newWid := StringWidth(theItem);
                        newLen := PRED(newLen);
                    UNTIL (newWid <= wid) | (newLen = 0);

                    END;

                PenNormal;

                {$IFC qDebug}
                AssumeFocused;
                {$ENDC}

                WITH colorRect DO
                    BEGIN
                    right := right - 1;
                    bottom := bottom - 1;
                    END;
                EraseRect(colorRect);                    { this "paints" the background }

                GetFontInfo(theFontInfo);
                WITH theFontInfo DO
                    SetRect(theItemRect, left + leftSlop, bottom -
                            botSlop - ascent,  { top computed based on the bottom - text
                                                             height }
                            right - rightSlop, bottom - botSlop + descent);
                MADrawString(@theItem, theItemRect, teJustSystem);

                SetIfColor(gRGBBlack);
                WITH botRight DO
                    BEGIN
                    h := h - 1;
                    v := v - 1;
                    END;
                FrameRect(menuRect);
                MoveTo(left + 3, bottom);
                LineTo(right, bottom);
                LineTo(right, top + 3);
                END;
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

FUNCTION TPopup.GetCurrentItem: INTEGER;

    BEGIN
    GetCurrentItem := fCurrentItem;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TPopup.GetItemText(item: INTEGER;
                             VAR theText: Str255);

    BEGIN
    IF fMenuHandle <> NIL THEN
        GetItem(fMenuHandle, item, theText)
    ELSE
        theText := '';
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TPopup.ReleasePopup;

    BEGIN
    IF fMenuHandle <> NIL THEN
        BEGIN
        HPurge(Handle(fMenuHandle));
        ReleaseResource(Handle(fMenuHandle));
        fMenuHandle := NIL;
        END;
    fMenuID := kNoResource;
    fCurrentItem := 0;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TPopup.SetCurrentItem(item: INTEGER;
                                redraw: BOOLEAN);

    VAR
        menuRect:            Rect;
        newFColor:            RGBColor;
        newBkColor:         RGBColor;

    BEGIN
    IF (fMenuHandle <> NIL) & (item <> fCurrentItem) THEN
        BEGIN
        IF fCurrentItem <> 0 THEN
            SetItemMark(fMenuHandle, fCurrentItem, ' ');
        IF item <> 0 THEN
            SetItemMark(fMenuHandle, item, CHR(checkMark));
        fCurrentItem := item;
        END;
    IF redraw & Focus & IsVisible THEN
        BEGIN
        GetQDExtent(menuRect);
        GetMenuColors(menuRect, fMenuID, item, newFColor, newBkColor);
        SetIfColor(newFColor); SetIfBkColor(newBkColor);
        DrawPopupBox(menuRect);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TPopup.SetPopup(theMenu: MenuHandle;
                          theRsrcID, currentItem: INTEGER;
                          redraw: BOOLEAN);

    VAR
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    ReleasePopup;
    IF theMenu <> NIL THEN
        BEGIN
        IF theRsrcID <> kNoResource THEN
            BEGIN
            CatchFailures(fi, HandleFailure);
            DetachResource(Handle(theMenu));
            FailResError;
            Success(fi);
            END;
        fMenuHandle := theMenu;
        fMenuID := theMenu^^.menuID;
        END;
    fRsrcID := theRsrcID;
    SetCurrentItem(Max(1, currentItem), kDontRedraw);
    AdjustBotRight;
    IF redraw THEN
        ForceRedraw;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TPopup.Fields(PROCEDURE DoToField(fieldName: Str255;
                                            fieldAddr: Ptr;
                                            fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TPopup', NIL, bClass);
    DoToField('fRsrcID', @fRsrcID, bInteger);
    DoToField('fMenuID', @fMenuID, bInteger);
    DoToField('fMenuHandle', @fMenuHandle, bHandle);
    DoToField('fCurrentItem', @fCurrentItem, bInteger);
    DoToField('fItemOffset', @fItemOffset, bInteger);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEOpen}

PROCEDURE TDialogTEView.IDialogTEView(itsDocument: TDocument; itsSuperView: TView; itsLocation,
                                      itsSize: VPoint; itsHDeterminer,
                                      itsVDeterminer: SizeDeterminer; itsInset: Rect;
                                      itsTextStyle: TextStyle; itsJustification: INTEGER;
                                      itsStyleType, itsAutoWrap: BOOLEAN);

    BEGIN
    fEditText := NIL; { We don't own this reference but we don't want an invalid one either }
    fScroller := NIL;

    ITEView(itsDocument, itsSuperView, itsLocation, itsSize, itsHDeterminer, itsVDeterminer,
            itsInset, itsTextStyle, itsJustification, itsStyleType, itsAutoWrap);

    fScroller := MakeScroller;
    IF fScroller <> NIL THEN
        fScroller.AddSubView(SELF);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEOpen}

PROCEDURE TDialogTEView.IRes(itsDocument: TDocument;
                             itsSuperView: TView;
                             VAR itsParams: Ptr); OVERRIDE;


    BEGIN
    fEditText := NIL;                                    { We don't own this reference but we don't
                                                         want an invalid one either }
    fScroller := NIL;
    INHERITED IRes(itsDocument, itsSuperView, itsParams);

    fScroller := MakeScroller;
    IF fScroller <> NIL THEN
        fScroller.AddSubView(SELF);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEClose}

PROCEDURE TDialogTEView.Free; OVERRIDE;


    BEGIN
    if fScroller <> NIL THEN
        BEGIN
        fScroller.RemoveSubView(SELF);
        FreeIfObject(fScroller);
        fScroller := NIL;
        END;

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TDialogTEView.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                   fieldAddr: Ptr;
                                                   fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TDialogTEView', NIL, bClass);
    DoToField('fEditText', @fEditText, bObject);
    DoToField('fScroller', @fScroller, bObject);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TDialogTEView.InstallEditText(theEditText: TEditText;
                                        selectChars: BOOLEAN);

    VAR
        theText:            Str255;
        aTextStyle:         TextStyle;
        theControlArea:     Rect;
        validExtent:        VRect;
        hadPendingUpdate:    Boolean;

    BEGIN
    IF fEditText <> NIL THEN
        BEGIN
        fEditText.RemoveSubView(fScroller);
        fEditText := NIL;
        END;

    IF theEditText <> NIL THEN
        BEGIN
        fControlChars := theEditText.fControlChars;
        fMaxChars := theEditText.fMaxChars;
        fInset := gZeroRect;
        hadPendingUpdate := theEditText.HasPendingUpdate;

        SetJustification(theEditText.fJust, kDontRedraw);
        ChangeWrap(theEditText.fAutoWrap, kDontRedraw);

        aTextStyle := theEditText.fTextStyle;
        SetOneStyle(0, 0, doAll, aTextStyle, kDontRedraw);

        theEditText.ControlArea(theControlArea);

        theEditText.AddSubView(fScroller);{ my scroller }

        IF fAutoWrap THEN
            fSizeDeterminer[h] := sizeSuperView
        ELSE
            fSizeDeterminer[h] := sizeVariable;    { Let the width vary with the number of characters }

        WITH theControlArea DO
            BEGIN
            fSuperView.Resize(right - left, bottom - top, kDontInvalidate);
            fSuperView.Locate(left, top, kDontInvalidate);
            END;

        theEditText.GetText(theText);
        SetText(theText);
        RecalcText;
        SynchView(kDontRedraw);
        AdjustSize;

    { Make the scroller's thinking match the display that the user already sees }
        fScroller.fTranslation.h := 0;
        CASE GetActualJustification(fJustification) OF
            teJustLeft, teForceLeft:
                fScroller.fTranslation.v := 0;
            teJustRight:    { Right brain thinkers… left brain thinkers?? }
                TScroller(fSuperView).fTranslation.h := fScroller.fMaxTranslation.h;
            teJustCenter:
                fScroller.fTranslation.h := fScroller.fMaxTranslation.h DIV 2;
            END;
        theEditText.InvalidateFocus;

        IF selectChars THEN
            SetSelect(0, MAXINT, fHTE)
        ELSE
            SetSelect(0, 0, fHTE);                        { Caller will set the selection. }

        BeInScroller(fScroller);

    { Make my enable and my scroller's enable match my new superview }
    ViewEnable(theEditText.IsViewEnabled, kDontRedraw);
    fScroller.ViewEnable(theEditText.IsViewEnabled, kDontRedraw);
    fScroller.fRespondsToFunctionKeys := FALSE;            { !!! need a better way to let enclosing
                                                        dialog scroll by function keys if necessary }

    { Revalidate my extent to eliminate the flicker created by resizing the scrollers }
        IF NOT hadPendingUpdate & Focus THEN
            BEGIN
            GetExtent(validExtent);
            ValidVRect(validExtent);
            END;
        END;

    fEditText := theEditText;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TDialogTEView.InstallSelection(wasActive, beActive: BOOLEAN); OVERRIDE;

    BEGIN
 { If we're deselecting a field and it's been scrolled, invalidate it
  so that it is redrawn correctly.}
    IF NOT beActive THEN
        IF fScroller.fTranslation.v <> 0 THEN
            ForceRedraw
        ELSE
            CASE GetActualJustification(fJustification) OF
                teJustLeft, teForceLeft:
                    BEGIN
                    IF fScroller.fTranslation.h <> 0 THEN
                        ForceRedraw;
                    END;
                teJustRight:
                    BEGIN
                    IF fScroller.fTranslation.h <> fScroller.fMaxTranslation.h THEN
                        ForceRedraw;
                    END;
                teJustCenter:
                    BEGIN
                    IF fScroller.fTranslation.h <> (fScroller.fMaxTranslation.h DIV 2) THEN
                        ForceRedraw;
                    END;
            END;

    INHERITED InstallSelection(wasActive, beActive);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TDialogTEView.ComputeSize(VAR newSize: VPoint); OVERRIDE;

    BEGIN
    INHERITED ComputeSize(newSize);

    IF NOT fAutoWrap  THEN
        CASE fSizeDeterminer[h] OF
            sizeVariable:
                { TTEView already computed the variable size, bump it up to at leat the scroller's
                size so that the cursor is claimed for the EditText and the user can click anywhere. }
                IF NOT fStyleType THEN
                    newSize.h := Max(fScroller.fSize.h, newSize.h);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEOpen}

FUNCTION TDialogTEView.MakeScroller: TScroller;
{ Must return a scroller.  !!! enhance the TDialogTEView to be able to function without a scroller }
    VAR
        aScroller: TScroller;

    BEGIN
    aScroller := NIL;
    New(aScroller);
    FailNil(aScroller);
    aScroller.IScroller(NIL, gZeroVPt, gZeroVPt, sizeRelSuperView, sizeRelSuperView, 0, 0,
                        NOT kWantHScrollBar, NOT kWantVScrollBar);
    MakeScroller := aScroller;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TStaticText.IStaticText(itsSuperView: TView;
                                  itsLocation, itsSize: VPoint;
                                  itsHSizeDet, itsVSizeDet: SizeDeterminer;
                                  itsRsrcID, itsIndex: INTEGER);

    VAR
        aString:            Str255;
        fi:                 FailInfo;

    PROCEDURE HandleFailure(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fDataHandle := NIL;
    IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
    fRsrcID := itsRsrcID;
    fIndex := itsIndex;
    fJust := teJustSystem;                                { Default to system justification }
    fAutoWrap := TRUE;                                    { Default to compatibility with 2.0 }
    IF fRsrcID <> kNoResource THEN
        BEGIN
        CatchFailures(fi, HandleFailure);
        GetIndString(aString, fRsrcID, fIndex);
        FailResError;
        Success(fi);
        SetText(aString, kDontRedraw);
        END;
    ViewEnable(False, kDontRedraw);                     { Default is to not enable hit testing }
    fDefChoice := mStaticTextHit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TStaticText.IRes(itsDocument: TDocument;
                           itsSuperView: TView;
                           VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    fRsrcID := kNoResource;
    fIndex := 0;
    fDataHandle := NIL;
    INHERITED IRes(NIL, itsSuperView, itsParams);

    fAutoWrap := TRUE;                                    { Default to compatibility with 2.0 }
    fDefChoice := mStaticTextHit;
    WITH StaticTextTemplatePtr(itsParams)^ DO
        BEGIN
        fJust := just;
        SetText(data, kDontRedraw);
        END;

    OffsetPtrWStr(itsParams, SIZEOF(StaticTextTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TStaticText.WRes(theResource: ViewRsrcHndl;
                           VAR itsParams: Ptr); OVERRIDE;

    VAR
        theText:            Str255;
        stPtr:                StaticTextTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    GetText(theText);

    stPtr := StaticTextTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(StaticTextTemplate),
                                                 Length(theText)));

    WITH stPtr^ DO
        BEGIN
        just := fJust;
        { data := theText; }
        CopyStr255(theText, PRStr(data));
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TStaticText.WriteRes(theResource: ViewRsrcHndl;
                               VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'stat'; gWResType := 'TStaticText';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TStaticText.Free; OVERRIDE;

    BEGIN
    ReleaseText;

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TStaticText.ChangeWrap(newAutoWrap, redraw: BOOLEAN);

    BEGIN
    fAutoWrap := newAutoWrap;
    IF Redraw THEN
        ForceRedraw;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TStaticText.DoSubstitution(VAR theText: Str255);

    VAR
        aDialogView:        TDialogView;

    BEGIN
    aDialogView := TDialogView(GetDialogView);
    IF aDialogView <> NIL THEN
        aDialogView.ReplaceText(theText);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TStaticText.Draw(area: Rect); OVERRIDE;

    VAR
        theRect:            Rect;
        oldColor:            RGBColor;
        theText:            Str255;
        aTextStyle:         TextStyle;

    BEGIN
    IF fDataHandle <> NIL THEN
        BEGIN
        GetText(theText);
        DoSubstitution(theText);                        { Make the substitution if desired }
        ControlArea(theRect);
        PenNormal;                                        { ??? NECESSARY ??? }
        GetIfColor(oldColor);
        aTextStyle := fTextStyle;
        SetPortTextStyle(aTextStyle);
        ImageText(Ptr(ORD4(@theText) + 1), Length(theText), theRect, fJust);
        SetIfColor(oldColor);
        END;
    INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TStaticText.GetText(VAR theText: Str255);

    BEGIN
    IF fDataHandle <> NIL THEN
    { theText := fDataHandle^^ }
        CopyStr255(fDataHandle^^, @theText)
    ELSE
        theText := '';
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TStaticText.ImageText(text: Ptr;
                                Length: LONGINT;
                                box: Rect;
                                just: INTEGER);

    BEGIN
    MATextBox(text, Length, box, just, fAutoWrap, NIL, kNoEraseFirst, kSpaceForCaret);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TStaticText.ReleaseText;

    BEGIN
    Handle(fDataHandle) := DisposeIfHandle(fDataHandle);

    fRsrcID := kNoResource;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TStaticText.SetJustification(theJust: INTEGER;
                                       redraw: BOOLEAN);

    BEGIN
    fJust := theJust;
    IF redraw THEN
        ForceRedraw;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TStaticText.SetText(theText: Str255;
                              redraw: BOOLEAN);

    VAR
        area:                Rect;

    BEGIN
    IF (fDataHandle = NIL) | (theText <> fDataHandle^^) THEN
        BEGIN
        ReleaseText;
        fDataHandle := NewString(theText);
        IF MemError <> noErr THEN
            fDataHandle := NIL;
        IF redraw & Focus & IsVisible THEN
            BEGIN
            ControlArea(area);
            EraseRect(area);
            Draw(area);
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TStaticText.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                 fieldAddr: Ptr;
                                                 fieldType: INTEGER)); OVERRIDE;

    VAR
        aString:            Str255;

    BEGIN
    DoToField('TStaticText', NIL, bClass);
    DoToField('fRsrcID', @fRsrcID, bInteger);
    DoToField('fIndex', @fIndex, bInteger);
    DoToField('fDataHandle', @fDataHandle, bHandle);
    IF fDataHandle <> NIL THEN
        BEGIN
        aString := fDataHandle^^;
        DoToField('fDataHandle^^', @aString, bString);
        END;
    DoToField('fJust', @fJust, bInteger);
    DoToField('fAutoWrap', @fAutoWrap, bBoolean);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TEditText.IEditText(itsSuperView: TView;
                              itsLocation, itsSize: VPoint;
                              itsMaxChars: INTEGER);

    BEGIN
    fTEView := NIL;
    IStaticText(itsSuperView, itsLocation, itsSize, sizeFixed, sizeFixed, kNoResource, 0);

    fAutoWrap := FALSE;                                    { Default to compatibility with 2.0
                                                        Never the twain shall meet.}
    fMaxChars := itsMaxChars;
    fControlChars := [chLeft, chRight, chUp, chDown, chBackspace];
    fTextStyle := gSystemStyle;
    Inset(3, 3, kDontRedraw);                            { Default is a little, teeny inset… }
    fPenSize := Point($00010001);                        { …and a thin frame }
    fAdornment := kFrame;
    ViewEnable(TRUE, kDontRedraw);
    fDefChoice := mEditTextHit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TEditText.IRes(itsDocument: TDocument;
                         itsSuperView: TView;
                         VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    fTEView := NIL;
    INHERITED IRes(NIL, itsSuperView, itsParams);

    fAutoWrap := FALSE;                                    { Default to compatibility with 2.0
                                                        Never the twain shall meet.}
    WITH EditTextTemplatePtr(itsParams)^ DO
        BEGIN
        fMaxChars := maxChars;
        fControlChars := controlChars;
        END;
    fDefChoice := mEditTextHit;

    OffsetPtr(itsParams, SIZEOF(EditTextTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgClose}

PROCEDURE TEditText.Free; OVERRIDE;

    BEGIN
    IF fTEView <> NIL THEN
        BEGIN
        fTEView.InstallEditText(NIL, False);
        fTEView := NIL
        END;

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TEditText.WRes(theResource: ViewRsrcHndl;
                         VAR itsParams: Ptr); OVERRIDE;

    VAR
        edPtr:                EditTextTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    edPtr := EditTextTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(EditTextTemplate)));

    WITH edPtr^ DO
        BEGIN
        maxChars := fMaxChars;
        controlChars := fControlChars;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TEditText.WriteRes(theResource: ViewRsrcHndl;
                             VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'edit'; gWResType := 'TEditText';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TEditText.ChangeWrap(newAutoWrap, redraw: BOOLEAN); OVERRIDE;

    BEGIN
    INHERITED ChangeWrap(newAutoWrap, redraw);
    IF fTEView <> NIL THEN
        fTEView.ChangeWrap(newAutoWrap, redraw)
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TEditText.HandleMouseDown(theMouse: VPoint;
                               VAR info: EventInfo;
                               VAR hysteresis: Point;
                               VAR theCommand: TCommand): BOOLEAN; OVERRIDE;

    BEGIN
    IF (gTarget <> fTEView) THEN    { Get the floating TE installed if necessary }
        DoChoice(SELF, fDefChoice);

    HandleMouseDown := INHERITED HandleMouseDown(theMouse, info, hysteresis, theCommand);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TEditText.DoSubstitution(VAR theText: Str255); OVERRIDE;

    BEGIN
    { Default action is for editable text items is not to do any substitions }
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TEditText.Draw(area: Rect); OVERRIDE;

    VAR
        theRect:            Rect;

    BEGIN
    IF fTEView <> NIL THEN
        BEGIN
        GetQDExtent(theRect);
        Adorn(theRect, fPenSize, fAdornment);
        END
    ELSE
        INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TEditText.Fields(PROCEDURE DoToField(fieldName: Str255;
                                               fieldAddr: Ptr;
                                               fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TEditText', NIL, bClass);
    DoToField('fMaxChars', @fMaxChars, bInteger);
    DoToField('fTEView', @fTEView, bObject);
    DoToField('fControlChars', @fControlChars, bHexLongInt);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TEditText.GetText(VAR theText: Str255); OVERRIDE;

    VAR
        theChars:            Handle;
        numberOfChars:        INTEGER;

    BEGIN
    IF fTEView = NIL THEN
        INHERITED GetText(theText)
    ELSE
        BEGIN
        theChars := fTEView.ExtractText;
        numberOfChars := MIN(255, GetHandleSize(theChars));
        {$Push} {$R-}
        theText[0] := CHR(numberOfChars);
        {$Pop}
        BlockMove(Ptr(theChars^), Ptr(ORD4(@theText) + 1), numberOfChars);
        END;
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TEditText.ImageText(text: Ptr;
                              Length: LONGINT;
                              box: Rect;
                              just: INTEGER); OVERRIDE;

    BEGIN
    IF Length >= 0 THEN
        MATextBox(text, Length, box, just, fAutoWrap , NIL, kNoEraseFirst,
        kSpaceForCaret);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TEditText.RestartEdit(restartText: Str255);

    VAR
        area:                Rect;

    BEGIN
    IF fTEView.Focus THEN                                { First, attempt to focus the TEView }
        BEGIN
        ClipRect(gZeroRect);                            { Prevent TE from mucking up the hilite with
                                                         a stinking insertion point }

        InstallSelection(TRUE, False);                    { Deactivate the selection }
        SetText(restartText, kDontRedraw);                { Set the text to previous value }
        SetSelection(0, MAXINT, kDontRedraw);            { Select all characters }

        InstallSelection(False, TRUE);                    { Activate the selection }
        InvalidateFocus;                                { Make sure we re-focus }
        fTEView.ForceRedraw;
        END
    ELSE
        SetText(restartText, kDontRedraw);                { Just set the text if we can't focus }
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TEditText.SetJustification(theJust: INTEGER;
                                     redraw: BOOLEAN);

    BEGIN
    IF fTEView <> NIL THEN
        fTEView.SetJustification(theJust, redraw);
    INHERITED SetJustification(theJust, redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TEditText.SetSelection(selStart, selEnd: INTEGER;
                                 redraw: BOOLEAN);

    BEGIN
    IF fTEView <> NIL THEN
        BEGIN
        IF redraw & fTEView.Focus & fTEView.IsVisible THEN
            BEGIN
            TESetSelect(selStart, selEnd, fTEView.fHTE);
            END
        ELSE
            SetSelect(selStart, selEnd, fTEView.fHTE);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TEditText.SetText(theText: Str255;
                            redraw: BOOLEAN); OVERRIDE;

    VAR
        currentText:        Str255;
        area:                Rect;

    BEGIN
    IF fTEView <> NIL THEN
        BEGIN
        GetText(currentText);
        IF currentText <> theText THEN
            BEGIN
            fTEView.SetText(theText);
            fTEView.RecalcText;
            fTEView.SynchView(kDontRedraw);
            IF redraw & Focus & IsVisible THEN
                BEGIN
                ControlArea(area);
                EraseRect(area);
                DrawContents;
                END;
            END;
        END
    ELSE
        INHERITED SetText(theText, redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TEditText.InstallSelection(wasActive, beActive: BOOLEAN); OVERRIDE;

    BEGIN
    IF fTEView <> NIL THEN
        fTEView.InstallSelection(wasActive, beActive);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TEditText.StartEdit(selectChars: BOOLEAN;
                              theTEView: TDialogTEView);

    VAR
        myExtent:            VRect;
        minToSee:            Point;
        itsWindow:            TWindow;

    BEGIN
    IF theTEView = NIL THEN
        BEGIN
        {$IFC qDebug}
        ProgramBreak('the TEView is nil.');
        {$ENDC}
        EXIT(StartEdit);
        END;

    theTEView.InstallEditText(SELF, selectChars);
    fTEView := theTEView;
    itsWindow := GetWindow;                             { Set the window's target, which sets }
    IF itsWindow <> NIL THEN                            { …the application's target if it is }
        itsWindow.SetTarget(theTEView);                 { …the front window. }

    GetExtent(myExtent);
    InsetVRect(myExtent, - 10, - 10);
    minToSee.h := MIN(fSize.h + 10, kMaxCoord);
    minToSee.v := MIN(fSize.v + 10, kMaxCoord);

    RevealRect(myExtent, minToSee, kVisible);            { Make me visible }
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TEditText.StopEdit;

    VAR
        aString:            Str255;

    BEGIN
    IF fTEView <> NIL THEN
        BEGIN
        GetText(aString);                                { Must get the text before calling
                                                         InstallEditText }
        fTEView.InstallSelection(TRUE, False);
        fTEView.InstallEditText(NIL, False);
        fTEView := NIL;
        SetText(aString, kDontRedraw);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TEditText.Validate: LONGINT;

    VAR
        validateResult:     LONGINT;

    BEGIN
    validateResult := INHERITED Validate;
    IF (validateResult = kValidValue) & (fTEView <> NIL) & (GetHandleSize(fTEView.fText) >
       fMaxChars) THEN
        validateResult := kTooManyCharacters;
    Validate := validateResult;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TNumberText.INumberText(itsSuperView: TView;
                                  itsLocation, itsSize: VPoint;
                                  itsValue, itsMinimum, itsMaximum: LONGINT);

    VAR
        aString:            Str255;

    BEGIN
    IEditText(itsSuperView, itsLocation, itsSize, 255);
    {$IFC qDebug}
    IF itsMinimum > itsMaximum THEN
        WRITELN('Minimum value specified is greater than maximum for TNumberText.');
    {$ENDC}
    fMinimum := itsMinimum;
    fMaximum := itsMaximum;
    NumToString(itsValue, aString);
    SetText(aString, kDontRedraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TNumberText.IRes(itsDocument: TDocument;
                           itsSuperView: TView;
                           VAR itsParams: Ptr); OVERRIDE;

    VAR
        aString:            Str255;

    BEGIN
    INHERITED IRes(NIL, itsSuperView, itsParams);

    WITH NumberTextTemplatePtr(itsParams)^ DO
        BEGIN
        NumToString(value, aString);
        SetText(aString, kDontRedraw);
        {$IFC qDebug}
        IF minimum > maximum THEN
            WRITELN('Minimum value specified is greater than maximum for TNumberText.');
        {$ENDC}
        fMinimum := minimum;
        fMaximum := maximum;
        END;

    OffsetPtr(itsParams, SIZEOF(NumberTextTemplate));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TNumberText.WRes(theResource: ViewRsrcHndl;
                           VAR itsParams: Ptr); OVERRIDE;

    VAR
        nmPtr:                NumberTextTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    nmPtr := NumberTextTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(NumberTextTemplate)));

    WITH nmPtr^ DO
        BEGIN
        value := GetValue;
        minimum := fMinimum;
        maximum := fMaximum;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TNumberText.WriteRes(theResource: ViewRsrcHndl;
                               VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    gWResSignature := 'nmbr'; gWResType := 'TNumberText';
    WRes(theResource, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION TNumberText.GetValue: LONGINT;

    VAR
        aString:            Str255;
        theValue:            LONGINT;

    BEGIN
    GetText(aString);
    StringToNum(aString, theValue);
    GetValue := theValue;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TNumberText.SetValue(newValue: LONGINT;
                               redraw: BOOLEAN);

    VAR
        aString:            Str255;

    BEGIN
    newValue := Max(fMinimum, MIN(fMaximum, newValue));
    NumToString(newValue, aString);
    SetText(aString, redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgNonRes}

FUNCTION TNumberText.Validate: LONGINT; OVERRIDE;

    VAR
        theString:            Str255;
        decRec:             Decimal;
        extValue:            Extended;
        index:                INTEGER;
        validPrefix:        BOOLEAN;

    BEGIN
    Validate := kValidValue;

    {!!! This really begs for a fRequired field to test when the string is left empty }
    { Then we would inform the user that an empty string is not a valid option. }
    { Also a fDefault field is necessary. GetValue would return fDefault rather }
    { than 0 when the string is empty.    For now (2.0) we will not validate an empty
    { string and assume that if the user wants a value they will override. }

    GetText(theString);
    IF theString <> '' THEN
        BEGIN
        index := 1;
        Str2Dec(theString, index, decRec, validPrefix);
        IF validPrefix & (index > Length(theString)) & (decRec.exp >= 0) THEN
            BEGIN
            extValue := Dec2Num(decRec);
            IF extValue < fMinimum THEN
                Validate := kValueTooSmall
            ELSE IF extValue > fMaximum THEN
                Validate := kValueTooLarge;
            END
        ELSE
            Validate := kNonNumericCharacters;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S DlgFields}

PROCEDURE TNumberText.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                 fieldAddr: Ptr;
                                                 fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TNumberText', NIL, bClass);
    DoToField('fMinimum', @fMinimum, bLongInt);
    DoToField('fMaximum', @fMaximum, bLongInt);

    INHERITED Fields(DoToField);
    END;